perm filename M.F4[PAG,LCS] blob sn#598971 filedate 1981-07-12 generic text, type T, neo UTF8
01300		SUBROUTINE SLRV(KK,C)
01350		COMMON /Q/Q(1)
01400		Q(KK+4)=C+Q(KK+4)
01500		Q(KK+5)=C+Q(KK+5)
01550	C ADD NUM. TO HEIGHT PARAMETERS
01600		Q(KK+7)=-Q(KK+7)
01700	C  INVERT THE SLUR
01800		END
02000	
02200		FUNCTION CLEFN(Q,J)
02250		DIMENSION Q(1)
02300		CLEFN=0
02400		IF(Q(J).LT.3.)RETURN
02500		CLEFN=Q(J+5)
02600		END
03300	
03400		SUBROUTINE MMNN(K)
03450		COMMON /JN/J,N  /XRN/MM(500),NN(1)
03500		N=N+1
03900		IF(K.NE.3)NN(N)=-1
03950	C   FOR SECONDARY POSITIONS.
04100		MM(N)=J+K
04200		END
04400	
04500		FUNCTION CODEN(K,N,R,M)
04600		DIMENSION K(1),R(1)
04700		M=K(N)
04800		CODEN=R(M+1)
04900	C  GET THE CODE NUMBER AND SAVE THE POINTER IN M.
05000		END
05400		
05500		FUNCTION ZERO(X,Y)
05600		ZERO=X-Y
05800	CC	IF(ABS(ZERO).LE..01)ZERO=0
05900		IF(ZERO.LT.0)ZERO=-ZERO
05950		IF(ZERO.LE..01)ZERO=0
06000		END
06300	
06400	C DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
06500		SUBROUTINE  BARFAC(KPG,BFAC,JK)
06525		COMMON /STF/RSTFAC(8)  /XRN/RN(1) /PX/KPN(1) /Q/Q(1) /JN/J
06550		  R=RSTFAC(1)
06600		DO 5112 K=2,KPG
06800	5112	   IF(R.NE.RSTFAC(K))GO TO 6112
07200		RETURN
07400	C NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
07500	C  FIND LINE WITH MOST ACTIVITY.
07600	C  ALL THIS SORT OF WORKS.  SOMEDAY REVIEW IT.********
07700	6112	   DO 1112 K=1,8
07900	1112	   RN(K)=0
08000		DO 112 K=JK,J-1
08400		JD=KPN(K)
08500		R=Q(JD+1)
08900		IF(R.GT.3.)GO TO 112
09100		A=1.0
09200	C  CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
09300		IF(R.EQ.2)A=0.6
09400	C SKIP NON-RHYTHM CHORD NOTES.   RESTS ARE CONSIDERED LESS IMPORTANT.
09600		 IF(R.NE.1)GO TO 4112
09800		IF(Q(JD).LT.7)GO TO 112
09900		IF(Q(JD+9).LE.0)GO TO 112
10100	4112	   LF=Q(JD+2)+1
10200		RN(LF)=RN(LF)+A 
10300	112	   CONTINUE
10600		JD=1
10700		B=RN(1)*RSTFAC(1)
10900		DO 2112 K=2,KPG
11000		A=RN(K)*RSTFAC(K)
11200		IF(A.LE.B)GO TO 2112
11400		JD=K
11500		B=A
11600	2112	   CONTINUE
11900		BFAC=BFAC*(RSTFAC(JD)+.1)
12000	C  +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
12200		END